home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.05 May 91 / Math Parser ƒ / ParserProcs / LexicalAnalysis < prev    next >
Encoding:
Text File  |  1990-10-31  |  6.9 KB  |  228 lines  |  [TEXT/PJMM]
  1. unit LexicalAnalysis;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ParserGlobals;
  7.  
  8.  
  9.     procedure lexicalanalysis (var line: str255; var removeblanks: boolean; var ntot: integer; var sy, tokentype: hdlstringarray0; var pr: hdlintarray0; var error: str255);
  10.  
  11.  
  12. implementation
  13.  
  14.  
  15.     procedure lexicalanalysis;
  16.  
  17.         label
  18.             99, 999, 9999;
  19.  
  20.         type
  21.             indicate = array[1..maxnumberofstrings] of integer;
  22.             ptrindicate = ^indicate;
  23.             hdlindicate = ^ptrindicate;
  24.  
  25.         var
  26.             i, j, k, place, len, numstrings: integer;
  27.             ind: hdlindicate;
  28.             s1, s2, s3, s4, s5: boolean;
  29.             nst, nend: hdlintarray0;
  30.             astr: hdlstringarray0;
  31.             ch, ch1, ch2, ch3: char;
  32.  
  33.     begin
  34.  
  35.         ind := hdlindicate(NewHandle(SizeOf(indicate)));
  36.         nst := hdlintarray0(NewHandle(SizeOf(intarray0)));
  37.         nend := hdlintarray0(NewHandle(SizeOf(intarray0)));
  38.         astr := hdlstringarray0(NewHandle(SizeOf(stringarray0)));
  39.  
  40.         place := pos(semicolon, line);
  41.  
  42.         if place = 0 then
  43.             line := concat(line, ';');
  44.  
  45.         if removeblanks then
  46.             begin
  47.                 place := pos(blank, line);
  48.                 while place <> 0 do
  49.                     begin
  50.                         delete(line, place, 1);
  51.                         place := pos(blank, line);
  52.                     end;
  53.             end;
  54.  
  55.         for i := 1 to length(line) do
  56.             ind^^[i] := 0;            {initialize ind^^[i] array}
  57.  
  58.         for i := 1 to maxnumberofstrings do
  59.             astr^^[i] := '';          {initialize astr^^[i] array}
  60.  
  61.         for i := 1 to length(line) do
  62.             begin
  63.                 k := ord(line[i]);
  64.                 if ((65 <= k) and (k <= 90)) or ((97 <= k) and (k <= 122)) then
  65.                     ind^^[i] := 1;     {if line[i] is a letter of alphabet, set ind^^[i] = 1}
  66.                 if ((48 <= k) and (k <= 57)) or (k = 46) then
  67.                     ind^^[i] := 2;     {if line[i] is a number or decimal, set ind^^[i] = 2}
  68.             end;
  69.  
  70.         numstrings := 0;
  71.         for i := 1 to length(line) do
  72.             begin
  73.  
  74.                 if (i = 1) and ((ind^^[i] = 1) or (ind^^[i] = 2)) then
  75.                     begin
  76.                         numstrings := numstrings + 1;   {if first character is 1 or 2, string starts}
  77.                         nst^^[numstrings] := i;               {at the first character position of line}
  78.                     end;
  79.  
  80.                 if i > 3 then
  81.                     if (ind^^[i] = 2) and ((line[i - 1] = '+') or (line[i - 1] = '-')) then
  82.                         if ((line[i - 2] = 'e') or (line[i - 2] = 'E')) and ((ind^^[i - 3] = 2)) then
  83.                             goto 999;
  84.  
  85.                 if i > 4 then
  86.                     if (ind^^[i] = 2) and (ind^^[i - 1] = 2) and ((line[i - 2] = '+') or (line[i - 2] = '-')) then
  87.                         if ((line[i - 3] = 'e') or (line[i - 3] = 'E')) and ((ind^^[i - 4] = 2)) then
  88.                             goto 999;
  89.  
  90.                 if (i > 1) and (ind^^[i] <> 0) and (ind^^[i - 1] = 0) then
  91.                     begin
  92.                         numstrings := numstrings + 1;   {start of string at ith position if 1 or 2 follows}
  93.                         nst^^[numstrings] := i;               {a 0 after the first character position.}
  94.                     end;
  95.  
  96.                 if (i > 1) and (ind^^[i] = 0) and (ind^^[i - 1] <> 0) then     {end of string at (i-1)th position if}
  97.                     nend^^[numstrings] := i - 1;                                            {ith is a 0 and (i-1)the is <> 0}
  98.  
  99.                 if (i = length(line)) and ((ind^^[i] = 1) or (ind^^[i] = 2)) then
  100.                     nend^^[numstrings] := i;
  101.  
  102. 999:
  103.             end;
  104.  
  105.  
  106.         for i := 1 to numstrings do
  107.             astr^^[i] := copy(line, nst^^[i], nend^^[i] + 1 - nst^^[i]);
  108.  
  109.         DisposHandle(handle(ind));
  110.  
  111.         ntot := 0;
  112.         for i := 1 to numstrings do            {meshing strings and operators to get}
  113.             for j := 1 to length(line) do         {tokens, sy^^[i], i = 1, ntot}
  114.                 begin
  115.                     s1 := (j < nst^^[i]) and (i = 1);
  116.                     s2 := (nend^^[i] < j) and (j < nst^^[i + 1]) and (i < numstrings);
  117.                     s3 := (nend^^[i] < j) and (i = numstrings);
  118.                     if s1 or s2 or s3 then
  119.                         begin
  120.                             ntot := ntot + 1;
  121.                             sy^^[ntot] := line[j];
  122.                             goto 9999;
  123.                         end;
  124.                     if (nst^^[i] = j) then
  125.                         begin
  126.                             ntot := ntot + 1;
  127.                             sy^^[ntot] := astr^^[i];
  128.                             goto 9999;
  129.                         end;
  130.                     if (nst^^[i] < j) and (j <= nend^^[i]) then
  131.                         goto 9999;
  132. 9999:
  133.                 end;
  134.         sy^^[0] := '@';
  135.  
  136.         DisposHandle(handle(nst));
  137.         DisposHandle(handle(nend));
  138.         DisposHandle(handle(astr));
  139.  
  140.  
  141.         for i := 0 to ntot do  {setting token types, tokentype^^[i], i = 1, ntot}
  142.             begin
  143.                 tokentype^^[i] := 'string';
  144.                 if (sy^^[i] = exponent) or (sy^^[i] = asterisk) or (sy^^[i] = rightslash) or (sy^^[i] = plus) or (sy^^[i] = minus) or (sy^^[i] = equals) or (sy^^[i] = rightparen) or (sy^^[i] = semicolon) or (sy^^[i] = leftparen) or (sy^^[i] = ampersand) then
  145.                     tokentype^^[i] := 'binary';
  146.                 if (sy^^[i] = 'pi') or (tokentype^^[i] = 'string') and (((48 <= ord(sy^^[i][1])) and (ord(sy^^[i][1]) <= 57)) or (ord(sy^^[i][1]) = 46)) then
  147.                     tokentype^^[i] := 'constant';
  148.                 if (sy^^[i] = '''') or (sy^^[i] = 'sqrt') or (sy^^[i] = 'sin') or (sy^^[i] = 'cos') or (sy^^[i] = 'exp') or (sy^^[i] = 'ln') then
  149.                     tokentype^^[i] := 'function';
  150.                 if (tokentype^^[i] = 'string') and (tokentype^^[i] <> 'binary') and (tokentype^^[i] <> 'constant') and (tokentype^^[i] <> 'function') then
  151.                     tokentype^^[i] := 'variable';
  152.                 if i > 0 then
  153.                     begin
  154.                         s1 := ((sy^^[i] = plus) or (sy^^[i] = minus));
  155.                         s2 := (tokentype^^[i - 1] <> 'variable') and (tokentype^^[i - 1] <> 'constant');
  156.                         s3 := (sy^^[i - 1] <> rightparen) and (sy^^[i - 1] <> quote);
  157.                         if (s1 and s2 and s3) then
  158.                             tokentype^^[i] := 'unary';
  159.                     end;
  160.             end;
  161.  
  162.  
  163.         for i := 1 to ntot do
  164.             if (tokentype^^[i] = 'constant') and (sy^^[i] <> 'pi') then
  165.                 begin
  166.  
  167.                     for j := 1 to length(sy^^[i]) do
  168.                         begin
  169.                             ch1 := sy^^[i][j - 1];
  170.                             ch2 := sy^^[i][j];
  171.                             ch3 := sy^^[i][j + 1];
  172.                             s1 := (65 <= ord(ch2)) and (ord(ch2) <= 90);
  173.                             s2 := (97 <= ord(ch2)) and (ord(ch2) <= 122);
  174.                             s3 := (ch2 = 'e') or (ch2 = 'E');
  175.                             if (s1 or s2) and not s3 then
  176.                                 begin
  177.                                     error := 'constant or variable incorrectly constructed';
  178.                                     goto 99;
  179.                                 end;
  180.                             s1 := ((ch2 = 'e') or (ch2 = 'E'));
  181.                             s2 := ((48 <= ord(ch1)) and (ord(ch1) <= 57));
  182.                             s3 := ((48 <= ord(ch3)) and (ord(ch3) <= 57));
  183.                             s4 := ((ch3 = '+') or (ch3 = '-'));
  184.                             if (s1 and not s2) or (s1 and not (s3 or s4)) then
  185.                                 begin
  186.                                     error := 'constant or variable incorrectly constructed';
  187.                                     goto 99;
  188.                                 end;
  189.                             s1 := ((48 <= ord(ch2)) and (ord(ch2) <= 57));
  190.                             s2 := ((ch2 = 'e') or (ch2 = 'E'));
  191.                             s3 := ((ch2 = '+') or (ch2 = '-'));
  192.                             s4 := (ch2 = '.');
  193.                             if not (s1 or s2 or s3 or s4) then
  194.                                 begin
  195.                                     error := 'constant or variable incorrectly constructed';
  196.                                     goto 99;
  197.                                 end;
  198.                         end;
  199.                 end;
  200.  
  201.  
  202.         for i := 0 to ntot do     {setting precedence values for tokens}
  203.             begin
  204.                 if (sy^^[i] = exponent) then
  205.                     pr^^[i] := 8;
  206.                 if (tokentype^^[i] = 'function') then
  207.                     pr^^[i] := 7;
  208.                 if (sy^^[i] = asterisk) or (sy^^[i] = rightslash) then
  209.                     pr^^[i] := 6;
  210.                 if (sy^^[i] = plus) or (sy^^[i] = minus) then
  211.                     pr^^[i] := 5;
  212.                 if sy^^[i] = equals then
  213.                     pr^^[i] := 4;
  214.                 if (sy^^[i] = rightparen) or (sy^^[i] = semicolon) then
  215.                     pr^^[i] := 3;
  216.                 if sy^^[i] = leftparen then
  217.                     pr^^[i] := 2;
  218.                 if sy^^[i] = '@' then
  219.                     pr^^[i] := 1;
  220.                 if (tokentype^^[i] <> 'function') and (tokentype^^[i] <> 'binary') then
  221.                     pr^^[i] := 0;
  222.             end;
  223.  
  224. 99:
  225.     end;
  226.  
  227.  
  228. end.